rm(list = ls())
graphics.off()

BADA

data <- read.csv("IBM-HR-Emplyee-NoAttrition.csv")
rownames(data) <- data$Subj
data1 <- data[sapply(data, function(x) !is.factor(x))]
data1 <- subset(data1, select=-Subj)
(library(Matrix))
## [1] "Matrix"    "stats"     "graphics"  "grDevices" "utils"     "datasets" 
## [7] "methods"   "base"
(library(prettyGraphs)) 
## [1] "prettyGraphs" "Matrix"       "stats"        "graphics"    
## [5] "grDevices"    "utils"        "datasets"     "methods"     
## [9] "base"
(library(ExPosition))
##  [1] "ExPosition"   "prettyGraphs" "Matrix"       "stats"       
##  [5] "graphics"     "grDevices"    "utils"        "datasets"    
##  [9] "methods"      "base"
(library(InPosition)) 
##  [1] "InPosition"   "ExPosition"   "prettyGraphs" "Matrix"      
##  [5] "stats"        "graphics"     "grDevices"    "utils"       
##  [9] "datasets"     "methods"      "base"
(library(TExPosition))
##  [1] "TExPosition"  "InPosition"   "ExPosition"   "prettyGraphs"
##  [5] "Matrix"       "stats"        "graphics"     "grDevices"   
##  [9] "utils"        "datasets"     "methods"      "base"
(library(TInPosition))
##  [1] "TInPosition"  "TExPosition"  "InPosition"   "ExPosition"  
##  [5] "prettyGraphs" "Matrix"       "stats"        "graphics"    
##  [9] "grDevices"    "utils"        "datasets"     "methods"     
## [13] "base"
(library(PTCA4CATA)) 
## 
## Attaching package: 'PTCA4CATA'
## The following object is masked from 'package:InPosition':
## 
##     boot.ratio.test
##  [1] "PTCA4CATA"    "TInPosition"  "TExPosition"  "InPosition"  
##  [5] "ExPosition"   "prettyGraphs" "Matrix"       "stats"       
##  [9] "graphics"     "grDevices"    "utils"        "datasets"    
## [13] "methods"      "base"
(library(data4PCCAR))
##  [1] "data4PCCAR"   "PTCA4CATA"    "TInPosition"  "TExPosition" 
##  [5] "InPosition"   "ExPosition"   "prettyGraphs" "Matrix"      
##  [9] "stats"        "graphics"     "grDevices"    "utils"       
## [13] "datasets"     "methods"      "base"
(library(dplyr))
## 
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
##  [1] "dplyr"        "data4PCCAR"   "PTCA4CATA"    "TInPosition" 
##  [5] "TExPosition"  "InPosition"   "ExPosition"   "prettyGraphs"
##  [9] "Matrix"       "stats"        "graphics"     "grDevices"   
## [13] "utils"        "datasets"     "methods"      "base"
(library(gridExtra))
## 
## Attaching package: 'gridExtra'
## The following object is masked from 'package:dplyr':
## 
##     combine
##  [1] "gridExtra"    "dplyr"        "data4PCCAR"   "PTCA4CATA"   
##  [5] "TInPosition"  "TExPosition"  "InPosition"   "ExPosition"  
##  [9] "prettyGraphs" "Matrix"       "stats"        "graphics"    
## [13] "grDevices"    "utils"        "datasets"     "methods"     
## [17] "base"
(library(grid))
##  [1] "grid"         "gridExtra"    "dplyr"        "data4PCCAR"  
##  [5] "PTCA4CATA"    "TInPosition"  "TExPosition"  "InPosition"  
##  [9] "ExPosition"   "prettyGraphs" "Matrix"       "stats"       
## [13] "graphics"     "grDevices"    "utils"        "datasets"    
## [17] "methods"      "base"
datae <- data[,8]
resBADA <- tepBADA(DATA = data1,
                   scale = 'SS1', center = TRUE,
                   DESIGN = datae,
                   make_design_nominal = TRUE,
                   group.masses = NULL,
                   weights = NULL, graphs =  FALSE)

ScreePlot

PlotScree(ev = resBADA$TExPosition.Data$eigs,
          p.ev = NULL, max.ev = NULL, alpha = 0.05,
          col.ns = "#006D2C", col.sig = "#54278F",
          title = "Explained Variance per Dimension",plotKaiser = TRUE)

HeatMap

color4Var <- prettyGraphs::prettyGraphsColorSelection(ncol(data1))
col <- colorRampPalette(c("#BB4444", "#EE9988", "#FFFFFF", "#77AADD", "#4477AA"))
# Pseudo Heat Map. Correlation ----
# We need correlation to compare with PCA
corrMatBurt.list <- phi2Mat4BurtTable(data1)
corr4MCA.r <- corrplot::corrplot( as.matrix(corrMatBurt.list$phi2.mat), method="color", col=col(200), type="upper", addCoef.col = "black", tl.col = color4Var,
tl.srt = 45, #Text label color and rotation
number.cex = .5,
diag = TRUE  )

Fk <- resBADA$TExPosition.Data$fi
Fi <- resBADA$TExPosition.Data$fii
Fj <- resBADA$TExPosition.Data$fj

Factor Map J

col4Var <- prettyGraphsColorSelection(NCOL(data1))
baseMap.j <- PTCA4CATA::createFactorMap(Fj,
                            col.points   = col4Var,
                            alpha.points =  .3,
                            col.labels   = col4Var)
# A graph for the J-set
aggMap.j <- baseMap.j$zeMap_background + # background layer
  baseMap.j$zeMap_dots + baseMap.j$zeMap_text # dots & labels
# We print this Map with the following code
dev.new()
print(aggMap.j)
zeLines <- ggplot2::annotate("segment", x = c(0), y = c(0),
                    xend = Fj[,1],
                    yend = Fj[,2],
                    color = col4Var,
                    alpha = .5,
                    arrow = arrow(length = unit(.3, "cm") ) )
# Create the map by adding background, labels, and arrows:
aggMap.j.arrows <- baseMap.j$zeMap_background +
                                      zeLines + baseMap.j$zeMap_text
dev.new()
print(aggMap.j.arrows)

Factor Map I

baseMap.i <- PTCA4CATA::createFactorMap(Fi,
                                        col.points   = resBADA$Plotting.Data$fii.col,
                                        alpha.points =  .3)
# Plain map with color for the I-set
aggMap.i <- baseMap.i$zeMap_background + baseMap.i$zeMap_dots
#---------------------------------------------------------------------
# print this Map
dev.new()
print(aggMap.i)
col4data <- resBADA$Plotting.Data$fii.col
col4Means <- unique(col4data)
# create the map for the means
MapGroup    <- PTCA4CATA::createFactorMap(Fk,
                                axis1 = 1, axis2 = 2,
                                constraints = baseMap.i$constraints,
                                title = NULL,
                                col.points = col4Means,
                                display.points = TRUE,
                                pch = 19, cex = 5,
                                display.labels = TRUE,
                                col.labels = col4Means,
                                text.cex = 4,
                                font.face = "bold",
                                font.family = "sans",
                                col.axes = "darkorchid",
                                alpha.axes = 0.2,
                                width.axes = 1.1,
                            col.background = adjustcolor("lavender",
                                                      alpha.f = 0.2),
                            force = 1, segment.size = 0)
# The map with observations and group means
aggMap.i.withMeans <- aggMap.i+
  MapGroup$zeMap_dots + MapGroup$zeMap_text
#---------------------------------------------------------------------
# plot it!
dev.new()
print(aggMap.i.withMeans)

Create 75% Tolerance interval polygons

GraphTI.Hull.90 <- MakeToleranceIntervals(Fi,
                                  as.factor(datae),
                                  names.of.factors = c("Dim1","Dim2"),
                                  col = unique(col4data),
                                  line.size = .5, line.type = 3,
                                  alpha.ellipse = .2,
                                  alpha.line = .4,
                                  p.level = .75, # 75% TI
                                  type = 'hull' #
                                          # use 'hull' for convex hull
)
#---------------------------------------------------------------------
# Create the map
aggMap.i.withHull <- aggMap.i +
  GraphTI.Hull.90 + MapGroup$zeMap_dots +
  MapGroup$zeMap_text +  MapGroup$zeMap_dots
#---------------------------------------------------------------------
# Plot it!
dev.new()
print(aggMap.i.withHull)

Inferences

resBADA.inf <- tepBADA.inference.battery(DATA = data1,
                   scale = 'SS1', center = TRUE,
                   DESIGN = datae,
                   make_design_nominal = TRUE,
                   group.masses = NULL,
                   weights = NULL,
                   graphs = FALSE,
                   k = 2,
                   test.iters = 100,
                   critical.value = 2)
## [1] "It is estimated that your iterations will take 0.71 minutes."
## [1] "R is not in interactive() mode. Resample-based tests will be conducted. Please take note of the progress bar."
## ===========================================================================
#---------------------------------------------------------------------
# Confusion matrices
# To be saved as table
fixedCM   <-   resBADA.inf$Inference.Data$loo.data$fixed.confuse
looedCM   <- resBADA.inf$Inference.Data$loo.data$loo.confuse

#---------------------------------------------------------------------
# Create Confidence Interval Plots
BootCube <- resBADA.inf$Inference.Data$boot.data$fi.boot.data$boots
dimnames(BootCube)[[2]] <- c("Dimension 1","Dimension 2")
# use function MakeCIEllipses from package PTCA4CATA
GraphElli <- MakeCIEllipses(BootCube[,1:2,],
                  names.of.factors = c("Dimension 1","Dimension 2"),
                  col = col4Means,
                  p.level = .95
)
#---------------------------------------------------------------------
# create the I-map with Observations, means and confidence intervals
#
aggMap.i.withCI <-  aggMap.i +  GraphElli + MapGroup$zeMap_text
#---------------------------------------------------------------------
# plot it!
dev.new()
print(aggMap.i.withCI)

Contribution

signed.ctrJ1 <- resBADA$TExPosition.Data$cj * sign(resBADA$TExPosition.Data$fj)
b003.ctrJ.s.11 <- PrettyBarPlot2(signed.ctrJ1[,1],
                                threshold = 1 / NROW(signed.ctrJ1),
                                font.size = 5,
                                # color4bar = gplots::col2hex(col4J.ibm), # we need hex code
                                main = 'BADA on the IBM-No-Attririon data Set: Variable Contributions (Signed)',
                                ylab = 'Contributions',
                                ylim = c(1.2*min(signed.ctrJ1), 1.2*max(signed.ctrJ1))
)
print(b003.ctrJ.s.11)

b004.ctrJ.s.21 <- PrettyBarPlot2(signed.ctrJ1[,2],
                                threshold = 1 / NROW(signed.ctrJ1),
                                font.size = 5,
                                # color4bar = gplots::col2hex(col4J.ibm), # we need hex code
                                main = 'BADA on the IBM-No-Attririon dataSet: Variable Contributions (Signed)',
                                ylab = 'Contributions',
                                ylim = c(1.2*min(signed.ctrJ1), 1.2*max(signed.ctrJ1))
)
print(b004.ctrJ.s.21)

Bootstrap Ratios

BR1 <- resBADA.inf$Inference.Data$boot.data$fj.boot.data$tests$boot.ratios
laDim = 1
ba001.BR11 <- PrettyBarPlot2(BR1[,laDim],
                            threshold = 2,
                            font.size = 5,
                            #color4bar = gplots::col2hex(col4J.ibm),
                            main = paste0( 'BADA on the IBM-NoAttrition data Set: Bootstrap ratio ',laDim),
                            ylab = 'Bootstrap ratios'
                            #ylim = c(1.2*min(BR[,laDim]), 1.2*max(BR[,laDim]))
)
print(ba001.BR11)

#
laDim = 2
ba002.BR21 <- PrettyBarPlot2(BR1[,laDim],
                            threshold = 2,
                            font.size = 5,
                            #color4bar = gplots::col2hex(col4J.ibm),
                            main = paste0(
                              'BADA on the IBM-NoAttrition data Set: Bootstrap ratio ',laDim),
                            ylab = 'Bootstrap ratios'
)
print(ba002.BR21)

DiCA

data2 <- data[,11:32]
data2$Age <- data$Age
data2$MonthlyIncome <- cut(data1$MonthlyIncome,breaks = c(min(data2$MonthlyIncome)-1,5000 ,10000, max(data2$MonthlyIncome)+1),labels = c(1,2,3))
data2$DailyRate <- cut(data2$DailyRate,breaks = c(min(data2$DailyRate)-1,600 ,1100, max(data1$DailyRate)+1),labels = c(1,2,3))
data2$HourlyRate <- cut(data2$HourlyRate,breaks = c(min(data2$HourlyRate)-1,55 ,80, max(data2$HourlyRate)+1),labels = c(1,2,3))
data2$MonthlyRate <- cut(data2$MonthlyRate,breaks = c(min(data2$MonthlyRate)-1,10000 ,17500, max(data2$MonthlyRate)+1),labels = c(1,2,3))
data2$DistanceFromHome <- cut(data2$DistanceFromHome,breaks = c(min(data2$DistanceFromHome)-1,6 , max(data2$DistanceFromHome)+1),labels = c(1,2))
data2$Education <- cut(data2$Education,breaks = c(min(data2$Education)-1, 2,3 , max(data2$Education)+1),labels = c(1,2,3))
data2$JobInvolvement <- cut(data2$JobInvolvement,breaks = c(min(data2$JobInvolvement)-1,2.5,3.5, max(data2$JobInvolvement)+1),labels = c(1,2,3))
data2$JobLevel <- cut(data2$JobLevel,breaks = c(min(data2$JobLevel)-1,2,4, max(data2$JobLevel)+1),labels = c(1,2,3))
data2$NumCompaniesWorked <- cut(data2$NumCompaniesWorked,breaks = c(min(data2$NumCompaniesWorked)-1, 2,6, max(data2$NumCompaniesWorked)+1),labels = c(1,2,3))
data2$TotalWorkingYears <- cut(data2$TotalWorkingYears,breaks = c(min(data2$TotalWorkingYears)-1, 10, max(data2$TotalWorkingYears)+1),labels = c(1,2))
data2$PercentSalaryHike <- cut(data2$PercentSalaryHike,breaks = c(min(data2$PercentSalaryHike)-1, 13,19, max(data2$PercentSalaryHike)+1),labels = c(1,2,3))
data2$WorkLifeBalance <- cut(data2$WorkLifeBalance,breaks = c(min(data2$WorkLifeBalance)-1, 2, max(data2$WorkLifeBalance)+1),labels = c(1,2))
data2$Age <- cut(data2$Age,breaks = c(min(data2$Age)-1, 30,40, max(data2$Age)+1),labels = c(1,2,3))
data2$TrainingTimesLastYear <- cut(data2$TrainingTimesLastYear,breaks = c(min(data2$TrainingTimesLastYear)-1, 2,4, max(data2$TrainingTimesLastYear)+1),labels = c(1,2,3))
data2$YearsAtCompany <- cut(data2$YearsAtCompany,breaks = c(min(data2$YearsAtCompany)-1, 5,15, max(data2$YearsAtCompany)+1),labels = c(1,2,3))
data2$YearsInCurrentRole <- cut(data2$YearsInCurrentRole,breaks = c(min(data2$YearsInCurrentRole)-1, 4,10, max(data2$YearsInCurrentRole)+1),labels = c(1,2,3))
data2$YearsSinceLastPromotion <- cut(data2$YearsSinceLastPromotion,breaks = c(min(data2$YearsSinceLastPromotion)-1, 2,7, max(data2$YearsSinceLastPromotion)+1),labels = c(1,2,3))
data2$YearsWithCurrManager <- cut(data2$YearsWithCurrManager,breaks = c(min(data2$YearsWithCurrManager)-1, 4,10, max(data2$YearsWithCurrManager)+1),labels = c(1,2,3))
data2$PerformanceRating <- as.factor(data2$PerformanceRating)
data2$JobInvolvement <- as.factor(data2$JobInvolvement)
data2$StockOptionLevel <- as.factor(data2$StockOptionLevel)
data2$EnvironmentSatisfaction <- as.factor(data2$EnvironmentSatisfaction)
data2$JobSatisfaction <- as.factor(data2$JobSatisfaction)
data2$RelationshipSatisfaction <- as.factor(data2$RelationshipSatisfaction)
str(data2)
## 'data.frame':    1233 obs. of  23 variables:
##  $ MonthlyIncome           : Factor w/ 3 levels "1","2","3": 2 1 1 1 1 1 2 2 1 1 ...
##  $ DailyRate               : Factor w/ 3 levels "1","2","3": 1 3 1 2 3 3 1 3 2 1 ...
##  $ HourlyRate              : Factor w/ 3 levels "1","2","3": 2 2 1 2 3 2 1 3 3 1 ...
##  $ MonthlyRate             : Factor w/ 3 levels "1","2","3": 3 3 2 2 1 2 1 2 2 2 ...
##  $ DistanceFromHome        : Factor w/ 2 levels "1","2": 2 1 1 1 1 2 2 2 2 2 ...
##  $ PerformanceRating       : Factor w/ 2 levels "3","4": 2 1 1 1 2 2 2 1 1 1 ...
##  $ Education               : Factor w/ 3 levels "1","2","3": 1 3 1 1 2 1 2 2 2 1 ...
##  $ JobInvolvement          : Factor w/ 3 levels "1","2","3": 1 2 2 2 3 2 1 2 3 1 ...
##  $ JobLevel                : Factor w/ 3 levels "1","2","3": 1 1 1 1 1 1 2 1 1 1 ...
##  $ StockOptionLevel        : Factor w/ 4 levels "0","1","2","3": 2 1 2 1 4 2 1 3 2 1 ...
##  $ NumCompaniesWorked      : Factor w/ 3 levels "1","2","3": 1 1 3 1 2 1 1 2 1 1 ...
##  $ PercentSalaryHike       : Factor w/ 3 levels "1","2","3": 3 1 1 1 3 3 3 1 1 1 ...
##  $ TotalWorkingYears       : Factor w/ 2 levels "1","2": 1 1 1 1 2 1 1 2 1 1 ...
##  $ TrainingTimesLastYear   : Factor w/ 3 levels "1","2","3": 2 2 2 1 2 1 1 2 3 2 ...
##  $ WorkLifeBalance         : Factor w/ 2 levels "1","2": 2 2 2 1 1 2 2 1 2 2 ...
##  $ YearsAtCompany          : Factor w/ 3 levels "1","2","3": 2 2 1 2 1 1 2 2 1 2 ...
##  $ YearsInCurrentRole      : Factor w/ 3 levels "1","2","3": 2 2 1 2 1 1 2 2 1 2 ...
##  $ YearsSinceLastPromotion : Factor w/ 3 levels "1","2","3": 1 2 1 2 1 1 1 2 1 1 ...
##  $ YearsWithCurrManager    : Factor w/ 3 levels "1","2","3": 2 1 1 2 1 1 2 2 1 2 ...
##  $ EnvironmentSatisfaction : Factor w/ 4 levels "1","2","3","4": 3 4 1 4 3 4 4 3 1 4 ...
##  $ JobSatisfaction         : Factor w/ 4 levels "1","2","3","4": 2 3 2 4 1 3 3 3 2 3 ...
##  $ RelationshipSatisfaction: Factor w/ 4 levels "1","2","3","4": 4 3 4 3 1 2 2 2 3 4 ...
##  $ Age                     : Factor w/ 3 levels "1","2","3": 3 2 1 2 3 1 2 2 2 1 ...

HeatMap

color4Var1 <- prettyGraphs::prettyGraphsColorSelection(ncol(data2))
col <- colorRampPalette(c("#BB4444", "#EE9988", "#FFFFFF", "#77AADD", "#4477AA"))
# Pseudo Heat Map. Correlation ----
# We need correlation to compare with PCA
corrMatBurt.list1 <- phi2Mat4BurtTable(data2)
corr4MCA.r1 <- corrplot::corrplot( as.matrix(corrMatBurt.list1$phi2.mat), method="color", col=col(200), type="upper", addCoef.col = "black", tl.col = color4Var1,
tl.srt = 45, #Text label color and rotation
number.cex = .5,
diag = TRUE  )

resDICA <- tepDICA(DATA = data2,
                   DESIGN = datae,
                   make_design_nominal = TRUE,
                   make_data_nominal = TRUE,
                   group.masses = NULL,
                   weights = NULL, graphs =  FALSE)

ScreePlot for DICA

resDICA.inf1 <- tepDICA.inference.battery(DATA = data2,
                   DESIGN = datae,
                   make_design_nominal = TRUE,
                   make_data_nominal = TRUE,
                   group.masses = NULL,
                   weights = NULL,
                   graphs = FALSE,
                   k = 2,
                   test.iters = 100,
                   critical.value = 2)
## [1] "It is estimated that your iterations will take 0.45 minutes."
## [1] "R is not in interactive() mode. Resample-based tests will be conducted. Please take note of the progress bar."
## ===========================================================================
PlotScree(ev = resDICA$TExPosition.Data$eigs,
          p.ev = resDICA.inf1$Inference.Data$components$p.vals, max.ev = NULL, alpha = 0.05,
          col.ns = "#006D2C", col.sig = "#54278F",
          title = "Explained Variance per Dimension",plotKaiser = TRUE)

Factor Map J

#col4Var1 <- prettyGraphsColorSelection(NCOL(data))
baseMap.j1 <- PTCA4CATA::createFactorMap(resDICA$TExPosition.Data$fj,
                            col.points   = resDICA$Plotting.Data$fj.col,
                            alpha.points =  .3,
                            col.labels   = resDICA$Plotting.Data$fj.col)
# A graph for the J-set
aggMap.j1 <- baseMap.j1$zeMap_background + # background layer
  baseMap.j1$zeMap_dots + baseMap.j1$zeMap_text # dots & labels
# We print this Map with the following code
dev.new()
print(aggMap.j1)

Factor Map I

baseMap.i1 <- PTCA4CATA::createFactorMap(resDICA$TExPosition.Data$fii,
                                        col.points   = resDICA$Plotting.Data$fii.col,
                                        alpha.points =  .3)
# Plain map with color for the I-set
aggMap.i1 <- baseMap.i1$zeMap_background + baseMap.i1$zeMap_dots
#---------------------------------------------------------------------
# print this Map
dev.new()
print(aggMap.i1)
col4data1 <- resDICA$Plotting.Data$fii.col
col4Means1 <- unique(col4data1)
# create the map for the means
MapGroup1    <- PTCA4CATA::createFactorMap(resDICA$TExPosition.Data$fi,
                                axis1 = 1, axis2 = 2,
                                constraints = baseMap.i1$constraints,
                                title = NULL,
                                col.points = col4Means1,
                                display.points = TRUE,
                                pch = 19, cex = 5,
                                display.labels = TRUE,
                                col.labels = col4Means1,
                                text.cex = 4,
                                font.face = "bold",
                                font.family = "sans",
                                col.axes = "darkorchid",
                                alpha.axes = 0.2,
                                width.axes = 1.1,
                            col.background = adjustcolor("lavender",
                                                      alpha.f = 0.2),
                            force = 1, segment.size = 0)
# The map with observations and group means
aggMap.i.withMeans1 <- aggMap.i1+
  MapGroup1$zeMap_dots + MapGroup1$zeMap_text
#---------------------------------------------------------------------
# plot it!
dev.new()
print(aggMap.i.withMeans1)

Create 75% Tolerance interval polygons

GraphTI.Hull.901 <- MakeToleranceIntervals(resDICA$TExPosition.Data$fii,
                                  as.factor(datae),
                                  names.of.factors = c("Dim1","Dim2"),
                                  col = unique(col4data1),
                                  line.size = .5, line.type = 3,
                                  alpha.ellipse = .2,
                                  alpha.line = .4,
                                  p.level = .75, # 75% TI
                                  type = 'hull' #
                                          # use 'hull' for convex hull
)
#---------------------------------------------------------------------
# Create the map
aggMap.i.withHull1 <- aggMap.i1 +
  GraphTI.Hull.901 + MapGroup1$zeMap_dots +
  MapGroup1$zeMap_text +  MapGroup1$zeMap_dots
#---------------------------------------------------------------------
# Plot it!
dev.new()
print(aggMap.i.withHull1)

Inferences

#---------------------------------------------------------------------
# Confusion matrices
# To be saved as table
fixedCM1   <-   resDICA.inf1$Inference.Data$loo.data$fixed.confuse
looedCM1   <- resDICA.inf1$Inference.Data$loo.data$loo.confuse

#---------------------------------------------------------------------
# Create Confidence Interval Plots
BootCube1 <- resDICA.inf1$Inference.Data$boot.data$fi.boot.data$boots
dimnames(BootCube1)[[2]] <- c("Dimension 1","Dimension 2")
# use function MakeCIEllipses from package PTCA4CATA
GraphElli1 <- MakeCIEllipses(BootCube1[,1:2,],
                  names.of.factors = c("Dimension 1","Dimension 2"),
                  col = col4Means1,
                  p.level = .95
)
#---------------------------------------------------------------------
# create the I-map with Observations, means and confidence intervals
#
aggMap.i.withCI1 <-  aggMap.i1 +  GraphElli1 + MapGroup1$zeMap_text
#---------------------------------------------------------------------
# plot it!
dev.new()
print(aggMap.i.withCI1)

Contribution

signed.ctrJ <- resDICA$TExPosition.Data$cj * sign(resDICA$TExPosition.Data$fj)
b003.ctrJ.s.1 <- PrettyBarPlot2(signed.ctrJ[,1],
                                threshold = 1 / NROW(signed.ctrJ),
                                font.size = 5,
                                # color4bar = gplots::col2hex(col4J.ibm), # we need hex code
                                main = 'DICA on the IBM-No-Attririon data Set: Variable Contributions (Signed)',
                                ylab = 'Contributions',
                                ylim = c(1.2*min(signed.ctrJ), 1.2*max(signed.ctrJ))
)
print(b003.ctrJ.s.1)

b004.ctrJ.s.2 <- PrettyBarPlot2(signed.ctrJ[,2],
                                threshold = 1 / NROW(signed.ctrJ),
                                font.size = 5,
                                # color4bar = gplots::col2hex(col4J.ibm), # we need hex code
                                main = 'DICA on the IBM-No-Attririon dataSet: Variable Contributions (Signed)',
                                ylab = 'Contributions',
                                ylim = c(1.2*min(signed.ctrJ), 1.2*max(signed.ctrJ))
)
print(b004.ctrJ.s.2)

Bootstrap Ratios

BR <- resDICA.inf1$Inference.Data$boot.data$fj.boot.data$tests$boot.ratios
laDim = 1
ba001.BR1 <- PrettyBarPlot2(BR[,laDim],
                            threshold = 2,
                            font.size = 5,
                            #color4bar = gplots::col2hex(col4J.ibm),
                            main = paste0( 'DICA on the IBM-NoAttrition data Set: Bootstrap ratio ',laDim),
                            ylab = 'Bootstrap ratios'
                            #ylim = c(1.2*min(BR[,laDim]), 1.2*max(BR[,laDim]))
)
print(ba001.BR1)

#
laDim = 2
ba002.BR2 <- PrettyBarPlot2(BR[,laDim],
                            threshold = 2,
                            font.size = 5,
                            #color4bar = gplots::col2hex(col4J.ibm),
                            main = paste0(
                              'DICA on the IBM-NoAttrition data Set: Bootstrap ratio ',laDim),
                            ylab = 'Bootstrap ratios'
)
print(ba002.BR2)

Conclusion